

   MEMBER('ClarionTest.clw')                               ! This is a MEMBER module


   INCLUDE('ABRESIZE.INC'),ONCE
   INCLUDE('ABTOOLBA.INC'),ONCE
   INCLUDE('ABUTIL.INC'),ONCE
   INCLUDE('ABWINDOW.INC'),ONCE

                     MAP
                       INCLUDE('CLARIONTEST001.INC'),ONCE        !Local module procedure declarations
                     END


RunTests PROCEDURE                                         ! Generated from procedure template - Window


Finder          TestDllProcFinder
ProcQ           TestProcedureQueue
CallDll         calldllcltype
x               LONG
lpTestResult    long,dim(1000)
TestResult      &TestResultT
err             ULONG
                itemize(1),pre(Style)
Default             equate
Passed              equate
Failed              equate
                end
runall              byte(true)
TestDll              STRING(255)                           !
LB_Passed            BYTE                                  !
LB_UnitTest          STRING(100)                           !
LB_Result            STRING(200)                           !

                
Window               WINDOW('Clarion test harness'),AT(,,370,275),FONT('MS Sans Serif',8),RESIZE,GRAY,SYSTEM
                       PROMPT('Test Dll:'),AT(12,15),USE(?TestDll:Prompt)
                       ENTRY(@s255),AT(43,14,304,10),USE(TestDll)
                       BUTTON('...'),AT(351,14,10,10),USE(?LookupFile)
                       LIST,AT(13,31,349,219),USE(?LIST),HVSCROLL,FORMAT('162L(2)MY~Test Name~@s100@800L(2)Y~R' & |
  'esult~@s200@'),FROM(ProcQ),MARK(procq.mark)
                       BUTTON('Reload'),AT(100,254,54),USE(?Reload)
                       BUTTON('Run All'),AT(158,254,54),USE(?RunAll)
                       BUTTON('Run Selected'),AT(216,254,54),USE(?RunSelected)
                       BUTTON('&Close'),AT(309,254,54),USE(?Close)
                     END

ThisWindow           CLASS(WindowManager)
Init                   PROCEDURE(),BYTE,PROC,DERIVED
Kill                   PROCEDURE(),BYTE,PROC,DERIVED
TakeAccepted           PROCEDURE(),BYTE,PROC,DERIVED
TakeFieldEvent         PROCEDURE(),BYTE,PROC,DERIVED
                     END

Toolbar              ToolbarClass
FileLookup1          SelectFileClass
Resizer              CLASS(WindowResizeClass)
Init                   PROCEDURE(BYTE AppStrategy=AppStrategy:Resize,BYTE SetWindowMinSize=False,BYTE SetWindowMaxSize=False)
                     END


  CODE
  GlobalResponse = ThisWindow.Run()                        ! Opens the window and starts an Accept Loop

UpdateList          routine
    setcursor(cursor:wait)
    if Finder.GetExportedTestProcedures(TestDll,ProcQ)
        loop x = 1 to records(Procq)
            get(Procq,x)
            Procq.TestNameStyle = Style:Default
            Procq.PassedStyle = Style:Default
            ProcQ.TestResultStyle = Style:Default
            put(ProcQ)
        END
    END
    if ~records(procq)
        procq.TestName = 'No tests loaded'
        add(procq)
    END
    setcursor()
    display()
    
RunTests            ROUTINE
    setcursor(cursor:wait)
    dbg.Message('RunTests routine')
    if CallDll.Init(TestDll,0) <> Level:Benign
        message('Error initializing DLL call library: ' & CallDll.ErrorStr)
    ELSE
        loop x = 1 to records(ProcQ)
            get(ProcQ,x)
            dbg.Message('Got record ' & x & ', test ' & procq.TestName)
            if ~runall and procq.mark = FALSE
                dbg.Message('Skipping this item')
                CYCLE
            END
            ProcQ.TestResultStyle = Style:Failed
            if CallDll.Call(ProcQ.TestName,address(lpTestResult[x])) = 99
                dbg.Message('CallDll.call failed')
                procq.TestResult = 'Failed: ' & clip(procq.TestName) & ' ' & CallDll.ErrorStr
            ELSE
                dbg.Message('CallDll.call succeeded')
                TestResult &= (lpTestResult[x])
                if TestResult &= null
                    procq.passed = false
                    procq.TestResult = 'Failed: TestResult object was null'
                    dbg.Message('TestResult is null')
                ELSE
                    dbg.Message('TestResult.Passed: ' & TestResult.Passed & ', proc ' & TestResult.ProcedureName)
                    dbg.Message('Assigning ' & TestResult.ProcedureName & ' to ' & procq.TestName)
                    procq.TestName = TestResult.ProcedureName
                    if TestResult.Passed
                        procq.TestResult = 'Passed'
                        ProcQ.TestResultStyle = Style:Passed
                    ELSE
                        ! ProcQ.TestResultStyle = Style:Failed
                        procq.TestResult = 'Failed: ' & TestResult.Message
                    END
                end
            END
            dbg.Message('updating queue')
            put(procq)
        end
        calldll.kill()
    END
    display()
    setcursor()
    
!---------------------------------------------------------------------------
DefineListboxStyle ROUTINE
!|
!| This routine create all the styles to be shared in this window
!| It`s called after the window open
!|
  !------------------------------------
  !Style for ?LIST
  !------------------------------------
!---------------------------------------------------------------------------

ThisWindow.Init PROCEDURE

ReturnValue          BYTE,AUTO

  CODE
              dbg.init('RunTests')
      dbg.debugactive = true
      TestDll = clip(left(COMMAND()))
      dbg.Message('command(): ' & TestDll)
  GlobalErrors.SetProcedureName('RunTests')
    if TestDll = ''
    end
  SELF.Request = GlobalRequest                             ! Store the incoming request
  ReturnValue = PARENT.Init()
  IF ReturnValue THEN RETURN ReturnValue.
  SELF.FirstField = ?TestDll:Prompt
  SELF.VCRRequest &= VCRRequest
  SELF.Errors &= GlobalErrors                              ! Set this windows ErrorManager to the global ErrorManager
  CLEAR(GlobalRequest)                                     ! Clear GlobalRequest after storing locally
  CLEAR(GlobalResponse)
  SELF.AddItem(Toolbar)
  IF SELF.Request = SelectRecord
     SELF.AddItem(?Close,RequestCancelled)                 ! Add the close control to the window manger
  ELSE
     SELF.AddItem(?Close,RequestCompleted)                 ! Add the close control to the window manger
  END
  SELF.Open(Window)                                        ! Open window
          ?list{PROPSTYLE:TextColor, Style:Default}     = -1
      ?list{PROPSTYLE:BackColor, Style:Default}     = -1
      ?list{PROPSTYLE:TextSelected, Style:Default}  = -1
      ?list{PROPSTYLE:BackSelected, Style:Default}  = -1
  
      ?list{PROPSTYLE:TextColor, Style:Passed}     = color:green
      ?list{PROPSTYLE:BackColor, Style:Passed}     = color:white
      ?list{PROPSTYLE:TextSelected, Style:Passed}  = -1
      ?list{PROPSTYLE:BackSelected, Style:Passed}  = -1
  
      ?list{PROPSTYLE:TextColor, Style:Failed}     = color:red
      ?list{PROPSTYLE:BackColor, Style:Failed}     = color:white
      ?list{PROPSTYLE:TextSelected, Style:Failed}  = -1
      ?list{PROPSTYLE:BackSelected, Style:Failed}  = -1
        
      do UpdateList
      display()
  Do DefineListboxStyle
  Resizer.Init(AppStrategy:Spread)                         ! Controls will spread out as the window gets bigger
  SELF.AddItem(Resizer)                                    ! Add resizer to window manager
  INIMgr.Fetch('RunTests',Window)                          ! Restore window settings from non-volatile store
  Resizer.Resize                                           ! Reset required after window size altered by INI manager
  FileLookup1.Init
  FileLookup1.ClearOnCancel = True
  FileLookup1.Flags=BOR(FileLookup1.Flags,FILE:LongName)   ! Allow long filenames
  FileLookup1.SetMask('Test DLL','*.dll')                  ! Set the file mask
  FileLookup1.WindowTitle='Load DLL containing test procedures'
    do UpdateList
  SELF.SetAlerts()
  RETURN ReturnValue


ThisWindow.Kill PROCEDURE

ReturnValue          BYTE,AUTO

  CODE
  ReturnValue = PARENT.Kill()
  IF ReturnValue THEN RETURN ReturnValue.
  IF SELF.Opened
    INIMgr.Update('RunTests',Window)                       ! Save window data to non-volatile store
  END
  GlobalErrors.SetProcedureName
  RETURN ReturnValue


ThisWindow.TakeAccepted PROCEDURE

ReturnValue          BYTE,AUTO

Looped BYTE
  CODE
  LOOP                                                     ! This method receive all EVENT:Accepted's
    IF Looped
      RETURN Level:Notify
    ELSE
      Looped = 1
    END
    CASE ACCEPTED()
    OF ?TestDll
          do UpdateList      
    OF ?Reload
                  do UpdateList      
    OF ?RunAll
              runall = TRUE
              do RunTests
    OF ?RunSelected
              runall = FALSE
              do RunTests
    END
  ReturnValue = PARENT.TakeAccepted()
    CASE ACCEPTED()
    OF ?LookupFile
      ThisWindow.Update
      TestDll = FileLookup1.Ask(0)
      DISPLAY
    END
    RETURN ReturnValue
  END
  ReturnValue = Level:Fatal
  RETURN ReturnValue


ThisWindow.TakeFieldEvent PROCEDURE

ReturnValue          BYTE,AUTO

Looped BYTE
  CODE
  LOOP                                                     ! This method receives all field specific events
    IF Looped
      RETURN Level:Notify
    ELSE
      Looped = 1
    END
  CASE FIELD()
  OF ?LookupFile
                  do UpdateList          
  END
  ReturnValue = PARENT.TakeFieldEvent()
    RETURN ReturnValue
  END
  ReturnValue = Level:Fatal
  RETURN ReturnValue


Resizer.Init PROCEDURE(BYTE AppStrategy=AppStrategy:Resize,BYTE SetWindowMinSize=False,BYTE SetWindowMaxSize=False)


  CODE
  PARENT.Init(AppStrategy,SetWindowMinSize,SetWindowMaxSize)
  SELF.SetParentDefaults()                                 ! Calculate default control parent-child relationships based upon their positions on the window
  SELF.SetStrategy(?Reload, Resize:FixXToCenter+Resize:FixBottom, Resize:LockSize) ! Override strategy for ?Reload
  SELF.SetStrategy(?RunAll, Resize:FixXCenter+Resize:FixBottom, Resize:LockSize) ! Override strategy for ?RunAll
  SELF.SetStrategy(?RunSelected, Resize:FixXToCenter+Resize:FixBottom, Resize:LockSize) ! Override strategy for ?RunSelected

